home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 25
/
Cream of the Crop 25.iso
/
bbs
/
con_005c.zip
/
CONCORD.RAR
/
FAQFBASE.DOC
< prev
next >
Wrap
Text File
|
1997-04-25
|
4KB
|
126 lines
(* Short demonstration procedures about using Concord filebase O.O1 Gamma-2 *)
(* Written by Pasi Talliniemi on 21-May-95. Document has not been tested... *)
(* Procedures are self explaining, no further comments needed. Questions *)
(* should be addressed to the author either via Fidonet or Internet e-mail. *)
var
Cfg: ConfigRec; (* Read this from CONFIG.DAT ..... *)
HdrFile: File; (* ABCDEFGH.HDR header file ...... *)
TxtFile: File; (* ABCDEFGH.TXT description file . *)
FileListHdr: FileListRec; (* Current record in file list ... *)
FileListDesc: Array [0..1024] of Char; (* Current file description *)
FileListUploader: Array [0..35] of Char; (* Uploader of current file . *)
Function ReturnFileDatabaseName (FArea: FAreaRec): PathStr;
(* Function AddSlash returns directory name appended by a backslash \ *)
(* Function NumToHex returns longint value in 8 char long hexa number *)
(* Function CRC_32 returns CRC-32 value of given string ............. *)
(* Function Capit returns given string in uppercased format ......... *)
begin
if FArea.Basename <> '' then begin
ReturnFileDatabaseName := AddSlash (Cfg.Paths.FilebasePath) +
FArea.Basename;
end else begin
ReturnFileDatabaseName := AddSlash (Cfg.Paths.FilebasePath) +
NumToHex (CRC_32 (Capit (FArea.Name)));
end;
end;
Function OpenFileBase (FArea: FAreaRec): Integer;
var Fname: PathStr;
IOErr: Integer;
begin
Fname := ReturnFiledatabaseName (FArea);
Filemode := 66; (* Read/Write, Denynone *)
Assign (HdrFile, Fname + '.HDR');
Assign (TxtFile, Fname + '.TXT');
{$I-} Reset (HdrFile, SizeOf (FileListRec)); {$I+} IOErr := IOResult;
if IOErr <> 0 then begin
OpenFileBase := IOErr;
end else begin
{$I-} Reset (TxtFile, 1); {$I+} IOErr := IOResult;
if IOErr <> 0 then begin
OpenFileBase := IOErr;
Close (HdrFile);
end else begin
OpenFileBase := 0;
end;
end;
end;
Function CloseFileBase: Integer;
begin
{$I-}
Close (HdrFile);
Close (TxtFile);
{$I+}
CloseFileBase := IOResult;
end;
Function FileListCnt: LongInt;
begin
{$I-} FileListCnt := FileSize (HdrFile); {$I+}
if IOResult <> 0 then begin
FileListCnt := 0;
end;
end;
Function ReturnFileListHdr (N: LongInt): Boolean;
var Num: Word;
begin
ReturnFileListHdr := False;
if (N >= 1) and (N <= FileListCnt) then begin
{$I-}
Seek (HdrFile, N - 1);
BlockRead (HdrFile, FileListHdr, 1, Num);
{$I+}
ReturnFileListHdr := (Num = 1) and (IOResult = 0);
end;
end;
Function ReturnFileListDesc: Boolean;
var Num: Word;
begin
{$I-}
Seek (TxtFile, FileListHdr.DescPtr);
BlockRead (TxtFile, FileListDesc, FileListHdr.DescRecLen, Num);
{$I+}
ReturnFileListDesc := (Num = FileListHdr.DescRecLen) and (IOResult = 0);
end;
Function ReturnFileListUploader: Boolean;
var Num: Word;
begin
{$I-}
Seek (TxtFile, FileListHdr.DescPtr + FileListHdr.DescRecLen);
BlockRead (TxtFile, FileListUploader, FileListHdr.UpldrLen, Num);
{$I+}
ReturnFileListUploader := (Num = FileListHdr.UpldrLen) and (IOResult = 0);
end;
Function SaveFileList (N: LongInt): Boolean;
var Num1, Num2, Num3: Word;
begin
SaveFileList := False;
if (N >= 1) and (N <= FileListCnt + 1) then begin
{$I-}
Seek (HdrFile, N - 1);
BlockWrite (HdrFile, FileListHdr, 1, Num1);
Seek (TxtFile, FileListHdr.DescPtr);
BlockWrite (TxtFile, FileListDesc, FileListHdr.DescRecLen, Num2);
BlockWrite (TxtFile, FileListUploader, FileListHdr.UpldrLen, Num3);
{$I+}
SaveFileList := (Num1 = 1) and (Num2 = FileListHdr.DescRecLen)
and (Num3 = FileListHdr.UpldrLen) and (IOResult = 0);
end;
end;
Function AddFileList: Boolean;
begin
FileListHdr.DescPtr := FileSize (TxtFile);
AddFileList := SaveFileList (FileListCnt + 1);
end;
(* End of document *)